home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / gui / guienv372.lha / GUIEnvironment / M2Amiga / Examples / ResizingExample.mod < prev   
Encoding:
Text File  |  1994-09-14  |  12.7 KB  |  273 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: ResizingExample.mod $
  4.  
  5. $Revision: 1.3 $
  6.     $Date: 1994/09/14 17:41:57 $
  7.  
  8.     GUIEnvironment example: Resizing, GUIEnvironment gadgets
  9.  
  10.     M2Amiga Modula-2 Compiler V4.3
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15. ****************************************************************************)
  16. MODULE ResizingExample;
  17.  
  18. (* This example shows, how the gadget descriptions can be used for
  19.    resizable gadgets. It also shows the GUIEnvironment gadgets in action ! *)
  20.  
  21.   FROM SYSTEM     IMPORT ADR, ADDRESS, ASSEMBLE, TAG;
  22.   FROM ExecD      IMPORT MemReqs, MemReqSet, Node, NodePtr, MinList;
  23.   FROM ExecL      IMPORT AllocMem, FreeMem, RemTail, Insert;
  24.   FROM GadToolsD  IMPORT buttonKind, listviewKind, GtTags, NewGadgetFlagSet,
  25.                          NewGadgetFlags, stringKind;
  26.   FROM IntuitionD IMPORT WindowPtr, WindowFlagSet, WindowFlags, IDCMPFlagSet,
  27.                          IDCMPFlags, WaTags;
  28. IMPORT D:GUIEnvD,
  29.        L:GUIEnvL;
  30.  
  31.   FROM GUIEnvSupport IMPORT GADDESC, GADOBJS, TopazAttr;
  32.  
  33. CONST version = ADR("ResizingExample 1.3 (14.09.94)\n");
  34.  
  35. TYPE ListViewArr = ARRAY[0..9] OF ADDRESS;
  36.  
  37. CONST listviewALabs = ListViewArr{ADR("Amiga 500"), ADR("Amiga 500+"),
  38.                        ADR("Amiga 600"), ADR("Amiga 1000"),
  39.                        ADR("Amiga 1200"), ADR("Amiga 2000"),
  40.                        ADR("Amiga 3000"), ADR("Amiga 4000/030"),
  41.                        ADR("Amiga 4000/040"), ADR("Amiga XXXX/yyy")};
  42.       listviewCLabs = ListViewArr{ADR("2086"), ADR("80286"),
  43.                        ADR("80386"), ADR("80486"),
  44.                        ADR("Pentium"), ADR("MC 68000"),
  45.                        ADR("MC 68020"), ADR("MC 68030"),
  46.                        ADR("MC 68040"), ADR("MC 68060")};
  47.  
  48. VAR win : WindowPtr;
  49.     gui : D.GUIInfoPtr;
  50.     tagbuf : ARRAY[0..19] OF LONGCARD;
  51.  
  52.     prg : INTEGER;           (* for the progressIndicatorKind *)
  53.     alist,
  54.     clist  : MinList;        (* Lists for ListviewKind gadget *)
  55.  
  56.   (* Creates two exec.lists. One contains some amiga-models and the other
  57.      some cpu-kinds ! *)
  58.   PROCEDURE CreateLists;
  59.   VAR entry  : NodePtr;
  60.       i      : CARDINAL;
  61.   BEGIN
  62.     (* Init amiga-list & cpu-list/ same as NewList(ADR(...)) *)
  63.     ASSEMBLE(LEA     alist(A4), A0
  64.              MOVE.L  A0,(A0)
  65.              ADDQ.L  #4,(A0)
  66.              CLR.L   4(A0)
  67.              MOVE.L  A0,8(A0)
  68.              LEA     clist(A4), A0
  69.              MOVE.L  A0,(A0)
  70.              ADDQ.L  #4,(A0)
  71.              CLR.L   4(A0)
  72.              MOVE.L  A0,8(A0)
  73.     END);
  74.     FOR i := 0 TO 9 DO     (* make the list-entries *)
  75.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  76.       IF entry # NIL THEN
  77.         entry^.name := listviewALabs[i];
  78.         Insert(ADR(alist), entry, NIL);
  79.       END;
  80.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  81.       IF entry # NIL THEN
  82.         entry^.name := listviewCLabs[i];
  83.         Insert(ADR(clist), entry, NIL);
  84.       END;
  85.     END;
  86.   END CreateLists;
  87.  
  88. BEGIN
  89.   CreateLists;
  90.  
  91.   win := L.OpenGUIWindowA( 50, 50, 300, 150, ADR("GUIEnvironment - ResizingExample"),
  92.                           IDCMPFlagSet{gadgetUp, closeWindow, newSize,
  93.                                        refreshWindow, vanillaKey, gadgetDown},
  94.                            WindowFlagSet{activate, windowSizing,
  95.                                          windowDepth, windowClose,
  96.                                          windowDrag}, NIL,
  97.                            TAG(tagbuf, waMinWidth, 250,
  98.                                        waMinHeight,120,
  99.                                        waMaxWidth, 500,
  100.                                        waMaxHeight,200, NIL));
  101.   IF win # NIL THEN
  102.  
  103.     gui := L.CreateGUIInfoA(win, TAG(tagbuf, D.guiTextFont, TopazAttr(), NIL));
  104.     IF gui # NIL THEN
  105.  
  106.       (* This gadget is always 10 points away from the left, the top and
  107.          the also the right window border. And it is also always 35 points
  108.          away from the bottom window border *)
  109.  
  110.       L.CreateGUIGadgetA(gui, 10, 20, -10, -35, D.gegProgressIndicatorKind,
  111.                          TAG(tagbuf, D.gegText, ADR("Progress"),
  112.                                      D.gegFlags, NewGadgetFlagSet{placetextAbove},
  113.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  114.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  115.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  116.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  117.                              NIL));
  118.  
  119.       (* This gadget is always 10 points below the progessIndicatorKind
  120.          gadget and always 10 points right of the window border.
  121.          Its size is constant. *)
  122.       L.CreateGUIGadgetA(gui, 10, 10, 70, 18, buttonKind,
  123.                          TAG(tagbuf, D.gegText, ADR("_Plus"),
  124.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  125.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  126.                                                            D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  127.                                                            D.gegDistNorm,
  128.                                                            D.gegDistNorm),
  129.                              NIL));
  130.  
  131.       (* This gadget is always 10 points below the progessIndicatorKind
  132.          gadget and always 10 points left of the window border.
  133.          Its size is constant. Now we need the gegObjects tag,
  134.          because we don't refer to the previous gadget !
  135.          To say, this gadget is 10 points left of the right window border,
  136.          we must say it is 10+width away from the border !*)
  137.       L.CreateGUIGadgetA(gui, -80, 10, 70, 18, buttonKind,
  138.                          TAG(tagbuf, D.gegText, ADR("_Minus"),
  139.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  140.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  141.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  142.                                                                D.gegDistNorm,
  143.                                                                D.gegDistNorm),
  144.                                      D.gegObjects, GADOBJS(0, 0, 0, 0),
  145.                          NIL));
  146.  
  147.       IF L.DrawGUIA(gui, NIL) = D.geDone THEN
  148.         prg := 0;
  149.         LOOP
  150.           L.WaitGUIMsg(gui);
  151.  
  152.           IF    closeWindow IN gui^.msgClass THEN
  153.             EXIT;
  154.           ELSIF gadgetUp    IN gui^.msgClass THEN
  155.             IF    gui^.msgGadNbr = 1 THEN
  156.               IF prg < 10 THEN INC(prg) END;
  157.               L.SetGUIGadgetA(gui, 0, TAG(tagbuf, D.gegPICurrentValue, prg * 10, NIL));
  158.             ELSIF gui^.msgGadNbr = 2 THEN
  159.               IF prg >  0 THEN DEC(prg) END;
  160.               L.SetGUIGadgetA(gui, 0, TAG(tagbuf, D.gegPICurrentValue, prg * 10, NIL));
  161.             END;
  162.           ELSIF newSize     IN gui^.msgClass THEN
  163.             (* We only get this message if GUIEnvironment can't resize ! *)
  164.             EXIT;
  165.           END;
  166.         END;
  167.       END;
  168.  
  169.       (* And now a total new GUI: *)
  170.       IGNORE L.ChangeGUIA(gui, TAG(tagbuf, D.guiRemoveGadgets, TRUE, NIL));
  171.  
  172.       (* We don't know the actual size of the window now, but our GUI was
  173.         designed for the size 300/150, so we have to say this to GUIEnv *)
  174.       IGNORE L.ChangeGUIA(gui, TAG(tagbuf, D.guiCreationWidth, 300,
  175.                                            D.guiCreationHeight, 150, NIL));
  176.  
  177.       (* This string gadget is for the listview gadget to display the
  178.          selected entry ! To the left and to the right it is 20 points
  179.          away from the window border. *)
  180.       L.CreateGUIGadgetA(gui, 20, -45, -20, 13, stringKind,
  181.                          TAG(tagbuf, D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  182.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom,
  183.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  184.                                                                D.gegDistNorm),
  185.                          NIL));
  186.  
  187.       (* This gadget is always 20 points away from the left and the right
  188.          window border. And it is also always 45 points away from the
  189.          bottom window border and 30 from the top window border. *)
  190.  
  191.       L.CreateGUIGadgetA(gui, 20, 30, -20, -45, listviewKind,
  192.                          TAG(tagbuf, D.gegText, ADR("_List"),
  193.                                      D.gegFlags, NewGadgetFlagSet{placetextAbove},
  194.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  195.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  196.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  197.                                                                D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  198.                                      gtlvLabels, ADR(alist),
  199.                                      gtlvShowSelected, L.GetGUIGadget(gui, 0, D.gegAddress), (* the prev. gadget*)
  200.                          NIL));
  201.  
  202.       (* This gadget is always 10 points below the listviewKind
  203.          gadget and always 20 points right of the window border.
  204.          Its size is constant. *)
  205.       L.CreateGUIGadgetA(gui, 20, 10, 70, 18, buttonKind,
  206.                          TAG(tagbuf, D.gegText, ADR("_Amigas"),
  207.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  208.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  209.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjBottom,
  210.                                                                D.gegDistNorm,
  211.                                                                D.gegDistNorm),
  212.                          NIL));
  213.  
  214.       (* This gadget is always 10 points below the listviewKind gadget
  215.          as the previous gadget is also and always 20 points left of the
  216.          window border. Its size is constant.
  217.          To say this gadget is 20 points left of the right window border,
  218.          we must say it is 20+width away from the border !*)
  219.       L.CreateGUIGadgetA(gui, -90, 0, 70, 18, buttonKind,
  220.                          TAG(tagbuf, D.gegText, ADR("_CPUs"),
  221.                                      D.gegFlags, NewGadgetFlagSet{placetextIn},
  222.                                      D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  223.                                                                D.gegDistAbs+D.gegObjGadget+D.gegObjTop,
  224.                                                                D.gegDistNorm,
  225.                                                                D.gegDistNorm),
  226.                          NIL));
  227.  
  228.       (* This gadget draws a border around all gadgets which is always
  229.          10 points away from every border *)
  230.       L.CreateGUIGadgetA(gui, 10, 10, -10, -10, D.gegBorderKind,
  231.                          TAG(tagbuf,  D.gegText, ADR("Choose something"),
  232.                                       D.gegFlags, NewGadgetFlagSet{placetextAbove, ngHighlabel},
  233.                                       D.gegDescription, GADDESC(D.gegDistAbs+D.gegObjBorder+D.gegObjLeft,
  234.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjTop,
  235.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjRight,
  236.                                                                 D.gegDistAbs+D.gegObjBorder+D.gegObjBottom),
  237.                          NIL));
  238.  
  239.       IF L.DrawGUIA(gui, NIL) = D.geDone THEN
  240.         LOOP
  241.           L.WaitGUIMsg(gui);
  242.  
  243.           IF    closeWindow IN gui^.msgClass THEN
  244.             EXIT;
  245.           ELSIF gadgetUp    IN gui^.msgClass THEN
  246.             IF    gui^.msgGadNbr = 2 THEN  (* Amiga-list *)
  247.               L.SetGUIGadgetA(gui, 1, TAG(tagbuf, gtlvLabels, ADR(alist), NIL));
  248.             ELSIF gui^.msgGadNbr = 3 THEN  (* CPU-list *)
  249.               L.SetGUIGadgetA(gui, 1, TAG(tagbuf, gtlvLabels, ADR(clist), NIL));
  250.             END;
  251.           ELSIF newSize     IN gui^.msgClass THEN
  252.             EXIT;
  253.           END;
  254.         END;
  255.       END;
  256.     END;
  257.   END;
  258.  
  259. CLOSE
  260.   IF win # NIL THEN
  261.     L.CloseGUIWindow(win);
  262.     win := NIL;
  263.   END;
  264.   IF alist.tailPred # NIL THEN  (* Did we reach the InitList ? *)
  265.     WHILE alist.tailPred # ADR(alist) DO    (* free lists *)
  266.       FreeMem(RemTail(ADR(alist)), SIZE(Node));
  267.     END;
  268.     WHILE clist.tailPred # ADR(clist) DO    (* free lists *)
  269.       FreeMem(RemTail(ADR(clist)), SIZE(Node));
  270.     END;
  271.   END;
  272. END ResizingExample.
  273.